(* ******************************************
  *                                          *
  * Graphic Scene Engine, http://glscene.org *
  *                                          *
  ******************************************* *)

unit GXS.Polyhedron;

(* Standard polyhedrons *)

interface

uses
  System.Classes,

  Scene.Import.OpenGLx,
  Scene.VectorGeometry,
  GXS.Scene,
  GXS.VectorFileObjects,
  GXS.Objects,
  GXS.RenderContextInfo;

type

  (* The tetrahedron has no texture coordinates defined, ie. without using
    a texture generation mode, no texture will be mapped. *)
  TgxTetrahedron = class(TgxBaseMesh)
  public
    procedure BuildList(var rci: TgxRenderContextInfo); override;
  end;

  (* The octahedron has no texture coordinates defined, ie. without using
    a texture generation mode, no texture will be mapped. *)
  TgxOctahedron = class(TgxBaseMesh)
  public
    procedure BuildList(var rci: TgxRenderContextInfo); override;
  end;

  (* The hexahedron has no texture coordinates defined, ie. without using
    a texture generation mode, no texture will be mapped. *)
  TgxHexahedron = class(TgxBaseMesh)
  public
    procedure BuildList(var rci: TgxRenderContextInfo); override;
  end;

  (* The dodecahedron has no texture coordinates defined, ie. without using
    a texture generation mode, no texture will be mapped. *)
  TgxDodecahedron = class(TgxBaseMesh)
  public
    procedure BuildList(var rci: TgxRenderContextInfo); override;
  end;

  (* The icosahedron has no texture coordinates defined, ie. without using
    a texture generation mode, no texture will be mapped. *)
  TgxIcosahedron = class(TgxBaseMesh)
  public
    procedure BuildList(var rci: TgxRenderContextInfo); override;
  end;

  // -------------------------------------------------------------
implementation

// -------------------------------------------------------------


// --------------------
// --------------------  TgxTetrahedron ------------------------
// --------------------

procedure TgxTetrahedron.BuildList(var rci: TgxRenderContextInfo);
const
  Vertices: packed array [0 .. 3] of TAffineVector =
   ((X: 1.0; Y: 1.0; Z: 1.0),
    (X: 1.0; Y: - 1.0; Z: - 1.0),
    (X: - 1.0; Y: 1.0; Z: - 1.0),
    (X: - 1.0; Y: - 1.0; Z: 1.0));
  Triangles: packed array [0 .. 3] of packed array [0 .. 2]
    of Byte = ((0, 1, 3), (2, 1, 0), (3, 2, 0), (1, 2, 3));
var
  i, j: Integer;
  n: TAffineVector;
  faceIndices: PByteArray;
begin
  for i := 0 to 3 do
  begin
    faceIndices := @Triangles[i, 0];
    n := CalcPlaneNormal(Vertices[faceIndices^[0]], Vertices[faceIndices^[1]],
      Vertices[faceIndices^[2]]);
    glNormal3fv(@n);
    glBegin(GL_TRIANGLES);
    for j := 0 to 2 do
      glVertex3fv(@Vertices[faceIndices^[j]]);
    glEnd;
  end;
end;

// --------------------
// --------------------  TgxOctahedron ------------------------
// --------------------

procedure TgxOctahedron.BuildList(var rci: TgxRenderContextInfo);
const
  Vertices: packed array [0 .. 5] of TAffineVector =
   ((X: 1.0; Y: 0.0; Z: 0.0),
    (X: - 1.0; Y: 0.0; Z: 0.0),
    (X: 0.0; Y: 1.0; Z: 0.0),
    (X: 0.0; Y: - 1.0; Z: 0.0),
    (X: 0.0; Y: 0.0; Z: 1.0),
    (X: 0.0; Y: 0.0; Z: - 1.0));
  Triangles: packed array [0 .. 7] of packed array [0 .. 2]
    of Byte = ((0, 4, 2), (1, 2, 4), (0, 3, 4), (1, 4, 3), (0, 2, 5), (1, 5, 2),
    (0, 5, 3), (1, 3, 5));

var
  i, j: Integer;
  n: TAffineVector;
  faceIndices: PByteArray;
begin
  for i := 0 to 7 do
  begin
    faceIndices := @Triangles[i, 0];

    n := CalcPlaneNormal(Vertices[faceIndices^[0]], Vertices[faceIndices^[1]],
      Vertices[faceIndices^[2]]);
    glNormal3fv(@n);
    glBegin(GL_TRIANGLES);
    for j := 0 to 2 do
      glVertex3fv(@Vertices[faceIndices^[j]]);
    glEnd;
  end;
end;

// ------------------
// ------------------ TgxHexahedron ------------------
// ------------------

procedure TgxHexahedron.BuildList(var rci: TgxRenderContextInfo);
const
  Vertices: packed array [0 .. 7] of TAffineVector =
   ((X: - 1; Y: - 1; Z: - 1),
    (X: 1; Y: - 1; Z: - 1),
    (X: 1; Y: - 1; Z: 1),
    (X: - 1; Y: - 1; Z: 1),
    (X: - 1; Y: 1; Z: - 1),
    (X: 1; Y: 1; Z: - 1),
    (X: 1; Y: 1; Z: 1),
    (X: - 1; Y: 1; Z: 1));
  Quadrangles: packed array [0 .. 5] of packed array [0 .. 3]
    of Byte = ((0, 1, 2, 3), (3, 2, 6, 7), (7, 6, 5, 4), (4, 5, 1, 0),
    (0, 3, 7, 4), (1, 5, 6, 2));

var
  i, j: Integer;
  n: TAffineVector;
  faceIndices: PByteArray;
begin
  for i := 0 to 4 do
  begin
    faceIndices := @Quadrangles[i, 0];
    n := CalcPlaneNormal(Vertices[faceIndices^[0]], Vertices[faceIndices^[1]],
      Vertices[faceIndices^[2]]);
    glNormal3fv(@n);
    glBegin(GL_QUADS);
    for j := 0 to 7 do
      glVertex3fv(@Vertices[faceIndices^[j]]);
    glEnd;
  end;
end;

// ------------------
// ------------------ TgxDodecahedron ------------------
// ------------------

procedure TgxDodecahedron.BuildList(var rci: TgxRenderContextInfo);
const
  A = 1.61803398875 * 0.3; // (Sqrt(5)+1)/2
  B = 0.61803398875 * 0.3; // (Sqrt(5)-1)/2
  C = 1 * 0.3;
const
  Vertices: packed array [0 .. 19] of TAffineVector = ((X: - A; Y: 0; Z: B),
    (X: - A; Y: 0; Z: - B), (X: A; Y: 0; Z: - B), (X: A; Y: 0; Z: B), (X: B;
    Y: - A; Z: 0), (X: - B; Y: - A; Z: 0), (X: - B; Y: A; Z: 0), (X: B; Y: A;
    Z: 0), (X: 0; Y: B; Z: - A), (X: 0; Y: - B; Z: - A), (X: 0; Y: - B; Z: A),
    (X: 0; Y: B; Z: A), (X: - C; Y: - C; Z: C), (X: - C; Y: - C; Z: - C), (X: C;
    Y: - C; Z: - C), (X: C; Y: - C; Z: C), (X: - C; Y: C; Z: C), (X: - C; Y: C;
    Z: - C), (X: C; Y: C; Z: - C), (X: C; Y: C; Z: C));

  Polygons: packed array [0 .. 11] of packed array [0 .. 4]
    of Byte = ((0, 12, 10, 11, 16), (1, 17, 8, 9, 13), (2, 14, 9, 8, 18),
    (3, 19, 11, 10, 15), (4, 14, 2, 3, 15), (5, 12, 0, 1, 13),
    (6, 17, 1, 0, 16), (7, 19, 3, 2, 18), (8, 17, 6, 7, 18), (9, 14, 4, 5, 13),
    (10, 12, 5, 4, 15), (11, 19, 7, 6, 16));
var
  i, j: Integer;
  n: TAffineVector;
  faceIndices: PByteArray;
begin
  for i := 0 to 11 do
  begin
    faceIndices := @Polygons[i, 0];
    n := CalcPlaneNormal(Vertices[faceIndices^[0]], Vertices[faceIndices^[1]],
      Vertices[faceIndices^[2]]);
    glNormal3fv(@n);

    // glBegin(GL_TRIANGLE_FAN);
    // for j := 0 to 4 do
    // glVertex3fv(@vertices[faceIndices^[j]]);
    // glEnd;

    glBegin(GL_TRIANGLES);
    for j := 1 to 3 do
    begin
      glVertex3fv(@Vertices[faceIndices^[0]]);
      glVertex3fv(@Vertices[faceIndices^[j]]);
      glVertex3fv(@Vertices[faceIndices^[j + 1]]);
    end;
    glEnd;
  end;
end;

// ------------------
// ------------------ TgxIcosahedron ------------------
// ------------------

procedure TgxIcosahedron.BuildList(var rci: TgxRenderContextInfo);
const
  A = 0.5;
  B = 0.30901699437; // 1/(1+Sqrt(5))
const
  Vertices: packed array [0 .. 11] of TAffineVector = ((X: 0; Y: - B; Z: - A),
    (X: 0; Y: - B; Z: A), (X: 0; Y: B; Z: - A), (X: 0; Y: B; Z: A), (X: - A;
    Y: 0; Z: - B), (X: - A; Y: 0; Z: B), (X: A; Y: 0; Z: - B), (X: A; Y: 0;
    Z: B), (X: - B; Y: - A; Z: 0), (X: - B; Y: A; Z: 0), (X: B; Y: - A; Z: 0),
    (X: B; Y: A; Z: 0));
  Triangles: packed array [0 .. 19] of packed array [0 .. 2]
    of Byte = ((2, 9, 11), (3, 11, 9), (3, 5, 1), (3, 1, 7), (2, 6, 0),
    (2, 0, 4), (1, 8, 10), (0, 10, 8), (9, 4, 5), (8, 5, 4), (11, 7, 6),
    (10, 6, 7), (3, 9, 5), (3, 7, 11), (2, 4, 9), (2, 11, 6), (0, 8, 4),
    (0, 6, 10), (1, 5, 8), (1, 10, 7));

var
  i, j: Integer;
  n: TAffineVector;
  faceIndices: PByteArray;
begin
  for i := 0 to 19 do
  begin
    faceIndices := @Triangles[i, 0];

    n := CalcPlaneNormal(Vertices[faceIndices^[0]], Vertices[faceIndices^[1]],
      Vertices[faceIndices^[2]]);
    glNormal3fv(@n);

    glBegin(GL_TRIANGLES);
    for j := 0 to 2 do
      glVertex3fv(@Vertices[faceIndices^[j]]);
    glEnd;
  end;
end;

// ==================================================================
initialization

// ==================================================================

RegisterClasses([TgxDodecahedron, TgxIcosahedron, TgxHexahedron, TgxOctahedron,
  TgxTetrahedron]);

end.
